COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 test du GETSYMBOL i.e. le ramassage de 
C00005 ENDMK
C⊗;
; test du GETSYMBOL i.e. le ramassage de ;
; la table des symboles cree par LINK 10 ;

(DM RH (N) 
   ; ramene la partie droite de N ;
   ['LOGAND \777777 (CADR N)])

(DM LH (N) 
   ; ramene la partie gauche de N ;
   ['RH ['LOGSHIFT (CADR N) -18]])


(PROGN
  (SETQ LRAD50 '(
    /  0 1 2 3 4 5 6 7 8 9
    A B C D E F G H I J K L M N 
    O P Q R S T U V W X Y Z /. /$ /% ))
  'LRAD50)

(SETQ LH-1 (LOGSHIFT -1 18))

(DE RAD50 (N ;; L)
   ; convertit N (en RAD50) vers l'ASCII ;
   ; enleve les 4 derniers bits ;
   (SETQ N (LOGAND N \37777777777))
   (ESCAPE &FIN
      (REPEAT 6 
	(IF (ZEROP N) (&FIN))
	(SETQ L (CONS  (CNTH (1+ (REM N \50)) LRAD50) L))
	(SETQ N (QUO N \50))))
   (APPLY 'GENSYM L))))
   
(DE GETSYM (N)
   ; on recupere l'adresse de la table des symboles ;
   (SETQ JBSYM (STATUS 41 \400006))
   ; debut du travail ;
   (PRINT "Nb d'elements" 
	(SETQ NBELEM (// (MINUS (LOGOR (LH JBSYM) LH-1)) 2))
     "Adresse" (SETQ ADRESS (RH JBSYM))) 
   ; pour avoir des sorties en octal ;
   (STATUS 6 8)
   ; recupere les N 1ers symboles ;
  (REPEAT NBELEM 
   (TTAB 0) (PRIN1 ADRESS)
   (TTAB 8) (PRIN1 (STATUS 41 ADRESS))
   (TTAB 20) (PRIN1 (LOGSHIFT (STATUS 41 ADRESS) -32))
   (TTAB 24) (PRIN1 (RAD50 (STATUS 41 ADRESS)))
   (TTAB 36) (PRIN1 (STATUS 41 (INCR ADRESS)))
   (TERPRI) (INCR ADRESS))
  (STATUS 6 10)
'VOILA)))

(GETSYM)